{-# LANGUAGE ViewPatterns #-}
-----------------------------------------------------------------------------
--
-- Module      :  LLVM.Code.Instructions.Call
-- Copyright   :  Mikhail Belyaev
-- License     :  GPL (Just (Version {versionBranch = [3], versionTags = []}))
--
-- Maintainer  :
-- Stability   :
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------

module LLVM.Code.Instructions.Call where

-- IMPORTANT: we do not distinguish CALL and CALL2 inctructions here
import LLVM.Code.Shared
       (BBIndex(..), CallingConv(..), ValIndex(..),
        TypeIndex(..), CallingConv, ParamAttrIndex(..))
import LLVM.Parser.Record.Record
       (getCode, recordAsList, RecordType(..))

import LLVM.Util
import LLVM.Code.Instructions.Class (BuildableInstruction(..))

import LLVM.Code.Instructions.Util
       (Unwrappable(..), Matched(..), Matcher(..), matchRRwithCode)
import LLVM.Code.Types (Type)
import LLVM.Code.Instructions.Values
       (UnreachableInstruction(..), UnwindInstruction(..),
        ReturnInstruction(..), InvokeInstruction(..), CallInstruction(..))




instance BuildableInstruction CallInstruction where
    buildInstruction rr@(getCode -> Just cd) tt vt | cd == 22 || cd == 34 =
        case (matchRRwithCode tt vt [MInteger, MInteger, MValueTypePair, MMany MValue] cd rr) of
             [MdInteger (ParamAttrIndex -> pa), MdInteger (integerToIC -> Just cc),
                MdValueTypePair (fv,ty), (unwrap -> Just ovs) ] ->
                    Just $ CallInstruction {
                        callParamAttrs = pa,
                        callCConv = cc,
                        callType = ty,
                        callFValue = fv,
                        callOperands = ovs
                    }
             x -> Nothing
    buildInstruction _ _ _ = Nothing




instance BuildableInstruction InvokeInstruction where
    buildInstruction rr tt vt =
        case (matchRRwithCode tt vt [MInteger, MInteger, MInteger, MInteger, MValueTypePair, MMany MValue] 13 rr) of
             [MdInteger (ParamAttrIndex -> pa), MdInteger (integerToIC -> Just cc),
                MdInteger (BBIndex -> nbb), MdInteger (BBIndex -> ubb),
                MdValueTypePair (fv,ty), (unwrap -> Just ovs) ] ->
                     Just $ InvokeInstruction {
                        normalBB = nbb,
                        catchBB = ubb,
                        nestedCall = CallInstruction {
                            callParamAttrs = pa,
                            callCConv = cc,
                            callType = ty,
                            callFValue = fv,
                            callOperands = ovs
                        }
                     }
             _ -> Nothing



instance BuildableInstruction ReturnInstruction where
    buildInstruction rr@(getCode -> Just cd) tt vt =
        case (matchRRwithCode tt vt [MValueTypePair] 10 rr) of
             [MdValueTypePair (fv,ty)] ->
                   Just $ ReturnInstruction {
                        result = Just (ty,fv)
                   }
             _ -> if (cd == 10) then Just $ ReturnInstruction Nothing
                               else Nothing



instance BuildableInstruction UnwindInstruction where
    buildInstruction (getCode -> Just 14) _ _ = Just UnwindInstruction
    buildInstruction _ _ _ = Nothing



instance BuildableInstruction UnreachableInstruction where
    buildInstruction (getCode -> Just 15) _ _ = Just UnreachableInstruction
    buildInstruction _ _ _ = Nothing







